home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / TRAPDIP.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  4.6 KB  |  152 lines
  1. 10  'TRAPDIP - Trap Dipole - Dual Band - 30 APR 95 rev. 28 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  PROG$="trapdip"
  4. 40  COMMON U,UH,EX$,PROG$
  5. 50  CLS:KEY OFF:COLOR 7,0,1
  6. 60  PI=3.14159
  7. 70  UL$=STRING$(80,205)
  8. 80  U1$="####.###"
  9. 90  '
  10. 100  '.....start
  11. 110  CLS:ITER=0:LOOP=0   'reset counters
  12. 120  COLOR 15,2
  13. 130  PRINT " TRAP DIPOLE - Dual Band";
  14. 140  PRINT TAB(64);"(author unknown) ";
  15. 150  PRINT STRING$(80,32);
  16. 160  LOCATE CSRLIN-1,20:PRINT "edited for HAMCALC by George Murphy VE3ERP"
  17. 170  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  18. 180  REM   This may be from "Designing Trap Antenna: A New Approach",
  19. 190  REM   by W0JF, in Ham Radio Magazine, August 1987
  20. 200  '
  21. 210  '.....standard antenna notes
  22. 220  OPEN "I",1,"\data\docfiles\antenna.doc
  23. 230  IF EOF(1)THEN 250
  24. 240  INPUT#1,Z$:PRINT TAB(3);Z$:GOTO 230
  25. 250  CLOSE
  26. 260  PRINT UL$;
  27. 270  PRINT "  PRESS number in < > to:"
  28. 280  PRINT UL$;
  29. 290  PRINT "   < 1 >  RUN program"
  30. 300  IF L=0 THEN 330
  31. 310  PRINT "   < 2 >  Select a commercial coil for the antenna you just designed"
  32. 320  PRINT "   < 3 >  Design coils for the antenna you just designed"
  33. 330  PRINT "   < 0 >  EXIT"
  34. 340  Z$=INKEY$
  35. 350  IF Z$="1"THEN 410
  36. 360  IF Z$="2"AND L<>0 THEN U=L:CHAIN"aircore"
  37. 370  IF Z$="3"AND L<>0 THEN UH=L:CHAIN"coildsgn"
  38. 380  IF Z$="0"THEN RUN EX$
  39. 390  GOTO 340
  40. 400  '
  41. 410  VIEW PRINT 4 TO 24:CLS:VIEW PRINT
  42. 420  GOSUB 1210        'diagram
  43. 430  PRINT UL$;
  44. 440  GOTO 510
  45. 450  '
  46. 460  '.....display input
  47. 470  LOCATE CSRLIN-1:PRINT "       "
  48. 480  LOCATE CSRLIN-1,44:PRINT ".....";USING U1$;Z;
  49. 490  RETURN
  50. 500  '
  51. 510  '.....inputs
  52. 520  INPUT " ENTER: LOW band operating frequency............(MHz)";F1
  53. 530  Z=F1:GOSUB 460:PRINT " MHz"
  54. 540  INPUT " ENTER: HIGH band operating frequency...........(MHz)";F2
  55. 550  Z=F2:GOSUB 460:PRINT " MHz"
  56. 560  K=F1/F2
  57. 570  IF K>1 THEN FS=F2:F2=F1:F1=FS:K=F1/F2
  58. 580  F0=SQR(F1*F2):W0=2*PI*F0
  59. 590  Z0=575:Q=200
  60. 600  A0=60*PI/180:C=TAN(A0)+TAN(K*A0):B0=PI/2/SQR(K)-A0
  61. 610  F=C-1/TAN(B0)-1/TAN(B0*K):DF=1/(SIN(B0)*SIN(B0))+K/(SIN(B0*K)*SIN(B0*K))
  62. 620  B1=B0-F/DF:IF ABS(B1-B0)<10^-6 THEN GOTO 640
  63. 630  B0=B1:GOTO 610
  64. 640  B0=B1:X=Z0*TAN(A0)-Z0/TAN(B0)
  65. 650  T=Q*(F2*F2-F0*F0)/F2/F0:CAP=Q/W0/X*T/(1+T*T)*10^6
  66. 660  PRINT "        Optimum value of trap capacitors........";USING U1$;CAP;
  67. 670  PRINT " pF"
  68. 680  INPUT " ENTER: Value of nearest standard capacitor.....(pF)";CAPP
  69. 690  LOCATE CSRLIN-2:PRINT STRING$(79,32):LOCATE CSRLIN-1
  70. 700  PRINT "        C1, C2..................................";USING U1$;CAPP;
  71. 710  PRINT " pF"
  72. 720  L=W0*W0*CAPP:L=1/L*10^6:XS=-X*CAP/CAPP
  73. 730  PRINT "        L1, L2..................................";USING U1$;L;
  74. 740  PRINT " >H"
  75. 750  LIN=CSRLIN
  76. 760  C=TAN(A0)+TAN(K*A0)
  77. 770  F=C-1/(TAN(B0))-1/(TAN(B0*K))
  78. 780  DF= 1/(SIN(B0)*SIN(B0)) +K/SIN(B0*K)/SIN(B0*K)
  79. 790  B1=B0-F/DF
  80. 800  IF ABS(B1-B0)<10^-6 THEN 820
  81. 810  B0=B1:ITER = ITER+1:IF ITER >100 THEN GOTO 920 ELSE GOTO 770
  82. 820  B0=B1:X= Z0*TAN(A0)-Z0/TAN(B0):P=XS+X
  83. 830  IF ABS(X+XS)<ABS(XS/500) THEN GOTO 970
  84. 840  DP= Z0/COS(A0)/COS(A0)
  85. 850  A1= A0-P/DP
  86. 860  A0=A1:LOOP=LOOP +1
  87. 870  IF LOOP >25 GOTO 910 ELSE GOTO 760
  88. 880  '
  89. 890  '.....unsuitable capacitor value
  90. 900  IF ABS(XS+X)<=1 OR A0>=0 OR B0>=0 THEN 970
  91. 910  PRINT
  92. 920  PRINT " CHOICE OF TRAP PARAMETERS IS UNSATISFACTORY - ";
  93. 930  PRINT "VARY VALUE OF CAPACITOR."
  94. 940  PRINT " The Algorithm has failed to converge for C = ";CAPP;" pF."
  95. 950  L=0:GOTO 1350
  96. 960  '
  97. 970  '.....display element lengths
  98. 980  LOCATE CSRLIN-1
  99. 990  A=A0/2/PI*299.8/F2:B=B0/2/PI*299.8/F2-0.05/4*299.8/F0
  100. 1000  GOSUB 1130
  101. 1010  LG=2*A+2*B
  102. 1020  LOCATE LIN
  103. 1030  PRINT "        Length L................................";USING U1$;LG;
  104. 1040  PRINT " metres (";USING U1$;LG/0.3048;:PRINT " feet)"
  105. 1050  PRINT "        Dimension A.............................";USING U1$;A;
  106. 1060  PRINT " metres (";USING U1$;A/0.3048;:PRINT " feet)"
  107. 1070  PRINT "        Dimension B.............................";USING U1$;B;
  108. 1080  PRINT " metres (";USING U1$;B/0.3048;:PRINT " feet)"
  109. 1090  PRINT "        Efficiency..............................";USING U1$;EFF*100;
  110. 1100  PRINT "% @";F2;"MHz"
  111. 1110  GOTO 1350
  112. 1120  '
  113. 1130  '.....subroutine to determine ANTENNA EFFICIENCY.
  114. 1140  RL=W0*L*Q/(1+T*T):XL=XS-575*TAN(B0*PI/180)
  115. 1150  RNUM=RL:XNUM=XL+575*TAN(A0*PI/180)
  116. 1160  RDEN=575-XL*TAN(A0):XDEN=RS*TAN(A0)
  117. 1170  D=RDEN*RDEN+XDEN*XDEN
  118. 1180  R0=575/D*(RNUM*RDEN+XNUM*XDEN):X0=575/D*(RDEN*XNUM-RNUM*XDEN)
  119. 1190  EFF=33/(33+R0):RETURN
  120. 1200  '
  121. 1210  '.....diagram
  122. 1220  COLOR 0,7
  123. 1230  RO=3:CO=16
  124. 1240  LOCATE RO+1,CO:PRINT "                                                   "
  125. 1250  LOCATE RO+2,CO:PRINT " CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND L SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL "
  126. 1260  LOCATE RO+3,CO:PRINT " CALLDEFSNGSOUNDSOUNDSOUND B SOUNDSOUNDSOUNDDEFDBLCALLDEFSNGSOUNDSOUNDSOUND A SOUNDSOUNDSOUNDDEFDBLCALLDEFSNGSOUNDSOUNDSOUND A SOUNDSOUNDSOUNDDEFDBLCALLDEFSNGSOUNDSOUNDSOUND B SOUNDSOUNDSOUNDDEFDBLCALL "
  127. 1270  LOCATE RO+4,CO:PRINT " CALL        L1 CALL                       CALL L2        CALL "
  128. 1280  LOCATE RO+5,CO:PRINT " /SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVEORORORBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVE/BSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVEORORORBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND/ "
  129. 1290  LOCATE RO+6,CO:PRINT "         CLSSOUNDUSINGSOUND'          CALL CALL          CLSSOUNDUSINGSOUND'         "
  130. 1300  LOCATE RO+7,CO:PRINT "          C1            CALL CALL            C2          "
  131. 1310  LOCATE RO+8,CO:PRINT "                                                   "
  132. 1320  COLOR 7,0
  133. 1330  RETURN
  134. 1340  '
  135. 1350  '.....end
  136. 1360  GOSUB 1390
  137. 1370  GOTO 110  'start
  138. 1380  '
  139. 1390  'HARDCOPY
  140. 1400  GOSUB 1510:LOCATE 25,2:COLOR 14,6
  141. 1410  PRINT " Press 1 to print screen, 2 to print screen & ";
  142. 1420  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  143. 1430  Z$=INKEY$:IF Z$="3"THEN GOSUB 1510:RETURN
  144. 1440  IF Z$="1"OR Z$="2"THEN GOSUB 1510:GOTO 1460
  145. 1450  GOTO 1430
  146. 1460  FOR QX=1 TO 24:FOR QY=1 TO 80
  147. 1470  LPRINT CHR$(SCREEN(QX,QY));
  148. 1480  NEXT QY:NEXT QX
  149. 1490  IF Z$="2"THEN LPRINT CHR$(12)
  150. 1500  GOTO 1400
  151. 1510  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  152.